Syntax10.Scn.Fnt
MODULE Browser; (* J.Templ 16.8.89/23.04.92 *)
 IMPORT SYSTEM, Files, Texts, MenuViewers, TextFrames, Oberon;
 CONST
  IdBufLeng = 12000;
  IdBufLim = IdBufLeng - 100;
  maxImps = 30;
  SFtag = 0F9X;
  firstStr = 16;
 (*object modes*)
  Var =  1; Ind =  2; Con =  3; Fld = 4; Typ = 5; XProc = 6;
  CProc = 7; IProc = 8; Mod = 9; Head = 10; TProc = 11;
 (*Structure forms*)
  Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;
  Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
  Pointer = 13; ProcTyp = 14; Array = 15; DynArr = 16; Record = 17;
  optionChar = "\";
 TYPE
  Object = POINTER TO ObjDesc;
  Struct = POINTER TO StrDesc;
  ObjDesc = RECORD
   left, right, link: Object;
   typ:  Struct;
   name: INTEGER;
   mode: SHORTINT;
   marked: BOOLEAN;
   a0, a1:  LONGINT; (* a0 gives org in module list *)
   next: Object;   (* next module *)
  END ;
  StrDesc = RECORD
   form, mno, ref, level: SHORTINT;
   n, size, adr: LONGINT; (* adr gives org in type hierarchy *)
   BaseTyp: Struct;
   link, strobj: Object;
   sub, next: Struct (* type hierarchy *)
  END ;
  W: Texts.Writer;
  id: INTEGER;
  err: BOOLEAN;
  universe, topScope: Object;
  undftyp, bytetyp, booltyp, chartyp, sinttyp, inttyp, linttyp,
  realtyp, lrltyp, settyp, stringtyp, niltyp, notyp, sysptrtyp: Struct;
  nofGmod: INTEGER;   (*nof imports*)
  option: CHAR;
  first, showObj: BOOLEAN;
  GlbMod: ARRAY maxImps OF Object;
  IdBuf: ARRAY IdBufLeng OF CHAR;
  types: Struct;
  symFileExt: ARRAY 8 OF CHAR;
  (*needed for detecting import of SYSTEM *)
  syspos: LONGINT;
  impSystem: BOOLEAN; (* insert "SYSTEM, " at imppos or " IMPORT SYSTEM; cr cr" at -imppos *)
 PROCEDURE Ws(s: ARRAY OF CHAR); BEGIN Texts.WriteString(W, s) END Ws;
 PROCEDURE Wch(ch: CHAR); BEGIN Texts.Write(W, ch) END Wch;
 PROCEDURE Wln; BEGIN Texts.WriteLn(W) END Wln;
 PROCEDURE WriteName(obj: Object);
  VAR name: ARRAY 32 OF CHAR; i, n: INTEGER;
 BEGIN n := obj^.name;
  i := -1; REPEAT INC(i); name[i] := IdBuf[n + i] UNTIL name[i] = 0X;
  Ws(name)
 END WriteName;
 PROCEDURE WAdr(obj: Object);
 BEGIN IF option = "X" THEN Texts.WriteInt(W, obj^.a0, 0); Wch(" ") END
 END WAdr;
 PROCEDURE Indent(i: INTEGER);
 BEGIN WHILE i > 0 DO Ws("  "); DEC(i) END
 END Indent;
 PROCEDURE WriteRecords(typ: Struct; i: INTEGER);
 BEGIN
  WHILE typ # NIL DO
   Indent(i);
   WriteName(GlbMod[typ.mno]); Wch("."); WriteName(typ.strobj);
   Wln; WriteRecords(typ^.sub, i + 1);
   typ := typ^.next
  END
 END WriteRecords;
 PROCEDURE WriteModules(m: Object);
 BEGIN
  WHILE m # NIL DO
   m^.a0 := W.buf.len;
   WriteName(m); Wln;
   m := m^.next
  END
 END WriteModules;
 PROCEDURE^ WriteType(typ: Struct; i: INTEGER);
 PROCEDURE WriteBase(typ: Struct);
  VAR base: Struct;
 BEGIN base := typ^.BaseTyp;
  IF (base # NIL) & (base^.strobj^.marked OR (option = "X")) THEN
   Ws(" ("); WriteType(typ^.BaseTyp, 0);
   IF option = "x" THEN WriteBase(typ^.BaseTyp) END ;
   Wch(")")
  END;
 END WriteBase;
 PROCEDURE WriteFields(VAR obj: Object; i: INTEGER);
  VAR typ: Struct; mode: INTEGER;
 BEGIN typ := obj^.typ; mode := obj^.mode;
  LOOP
   WAdr(obj); WriteName(obj);
   IF obj^.marked THEN Wch("-") END ;
   obj := obj^.link;
   IF (obj = NIL) OR (obj^.mode # mode) OR (obj^.typ # typ) THEN EXIT END ;
   Ws(", ")
  END ;
  Ws(": "); WriteType(typ, i + 1)
 END WriteFields;
 PROCEDURE WriteParams(param: Object; res: Struct);
 BEGIN
  IF (param # NIL) OR (res # notyp) THEN
   Ws(" (");
   WHILE (param # NIL) DO
    IF param.mode = Ind THEN Ws("VAR ") END ;
    IF param.name = 0 THEN
     WriteType(param.typ, 0);
     param := param.link;
     IF param # NIL THEN Ws(", ") END
    ELSE
     WriteFields(param, 0);
     IF param # NIL THEN Ws("; ") END
    END
   END ;
   Wch(")");
  END ;
  IF res # notyp THEN Ws(": "); WriteType(res, 0) END
 END WriteParams;
 PROCEDURE WriteFieldList(obj: Object; i: INTEGER);
 BEGIN
  WHILE (obj # NIL) & (obj^.mode = Fld) DO
   Indent(i); WriteFields(obj, i); Wch(";"); Wln
  END ;
  WHILE (obj # NIL) & (obj^.mode = TProc) DO
   Indent(i);
   IF option = "X" THEN Texts.WriteInt(W, obj^.a0 MOD 10000H,1); Wch(" ");
    Texts.WriteInt(W, obj^.a0 DIV 10000H,1); Wch(" ")
   END ;
   Ws("PROCEDURE (");
   IF obj^.right^.mode = Ind THEN Ws("VAR ") END ;
   WAdr(obj^.right);
   WriteName(obj^.right);
   Ws(": ");
   WriteName(obj^.right^.typ^.strobj);
   Ws(") ");
   WriteName(obj);
   WriteParams(obj^.right^.link, obj^.typ);
   Wch(";"); Wln;
   obj := obj^.link
  END
 END WriteFieldList;
 PROCEDURE WriteInstVars(typ: Struct; i: INTEGER);
 BEGIN
  IF typ # NIL THEN
   IF option = "x" THEN WriteInstVars(typ^.BaseTyp, i) END;
   WriteFieldList(typ^.link, i);
  END
 END WriteInstVars;
 PROCEDURE WriteForm(typ: Struct; i: INTEGER);
  VAR param, p: Object;
 BEGIN
  IF typ^.form = Record THEN
   Ws("RECORD"); WriteBase(typ);
   IF option = "X" THEN Wch(" "); Texts.WriteInt(W, typ^.size, 1); Wch(" ") END ;
   IF (typ^.link # NIL) OR (option = "x") THEN Wln; WriteInstVars(typ, i); Indent(i - 1) ELSE Wch(" ") END ;
   Ws("END ")
  ELSIF typ^.form = Array THEN
   Ws("ARRAY "); Texts.WriteInt(W, typ^.n, 0); Ws(" OF "); WriteType(typ^.BaseTyp, i)
  ELSIF typ^.form = DynArr THEN
   Ws("ARRAY OF "); WriteType(typ^.BaseTyp, i)
  ELSIF typ^.form = Pointer THEN
   Ws("POINTER TO "); WriteType(typ^.BaseTyp, i)
  ELSIF typ^.form = ProcTyp THEN
   Ws("PROCEDURE");
   WriteParams(typ^.link, typ^.BaseTyp)
  END
 END WriteForm;
 PROCEDURE WriteType(typ: Struct; i: INTEGER);
 BEGIN
  IF typ^.strobj # NIL THEN
   IF (typ = bytetyp) OR (typ = sysptrtyp) THEN impSystem := TRUE END ;
   IF (typ^.mno > 1) OR ((typ^.mno = 1) & showObj) THEN WriteName(GlbMod[typ^.mno]); Wch(".") END ;
   WriteName(typ^.strobj)
  ELSE WriteForm(typ, i)
  END
 END WriteType;
 PROCEDURE WriteProc(obj: Object);
  VAR param: Object; i: LONGINT;
 BEGIN
  IF (option = "X") & (obj^.mode # CProc) THEN Texts.WriteInt(W, obj^.a0, 2); Indent(1) END ;
  Ws("PROCEDURE "); WriteName(obj);
  WriteParams(obj^.link, obj^.typ);
  IF (option = "X") & (obj^.mode = CProc) THEN Wch(" "); i := 0;
   WHILE i < obj^.a1 DO
    Texts.WriteInt(W, ORD(IdBuf[obj^.a0 + i]), 1); INC(i);
    IF i < obj^.a1 THEN Ws(", ") END
   END ;
  END ;
  Wch(";")
 END WriteProc;
 PROCEDURE WriteVal(obj: Object);
  VAR i: INTEGER; lr: LONGREAL; s: SET; ch: CHAR;
 BEGIN
  CASE obj.typ^.form OF
   SInt, Int, LInt: Texts.WriteInt(W, obj^.a0, 0) |
   Real: Texts.WriteReal(W, SYSTEM.VAL(REAL, obj^.a0), 15) |
   LReal: SYSTEM.MOVE(SYSTEM.ADR(obj^.a0), SYSTEM.ADR(lr), 8); Texts.WriteLongReal(W, lr, 23) |
   Bool: IF obj^.a0 = 0 THEN Ws("FALSE") ELSE Ws("TRUE") END |
   Char: IF (obj^.a0 >= 32) & (obj^.a0 <= 126) THEN
       Wch(22X); Wch(CHR(obj^.a0)); Wch(22X)
      ELSE
       i := SHORT(obj^.a0 DIV 16);
       IF i > 9 THEN Wch(CHR(55 + i)) ELSE Wch(CHR(48 + i)) END;
       i := SHORT(obj^.a0 MOD 16);
       IF i > 9 THEN Wch(CHR(55 + i)) ELSE Wch(CHR(48 + i)) END;
       Wch("X")
      END |
   Set: Wch("{"); i := 0; s := SYSTEM.VAL(SET, obj^.a0);
      WHILE i <= MAX(SET) DO
       IF i IN s THEN Texts.WriteInt(W, i, 0); EXCL(s, i);
        IF s # {} THEN Ws(", ") END
       END ;
       INC(i)
      END ;
      Wch("}") |
   NilTyp: Ws("NIL") |
   String: i := SHORT(obj^.a0); ch := IdBuf[i]; Wch(22X);
      WHILE ch # 0X DO Wch(ch); INC(i); ch := IdBuf[i] END ;
      Wch(22X)
  END
 END WriteVal;
 PROCEDURE WriteObject(VAR obj: Object; mode: INTEGER);
  VAR typ: Struct;
 BEGIN
  IF mode = Con THEN
   IF first THEN Indent(1); Ws("CONST"); Wln; first := FALSE END;
   Indent(2); WriteName(obj); Ws(" = "); WriteVal(obj); Wch(";");
   Wln
  ELSIF mode = Var THEN
   IF first THEN Indent(1); Ws("VAR"); Wln; first := FALSE END;
   Indent(2);
   LOOP
    WAdr(obj); WriteName(obj); typ := obj^.typ;
    IF obj^.marked THEN Wch("-") END ;
    WHILE (obj^.right # NIL) & (obj^.right^.mode # Var) DO obj := obj^.right END ;
    IF (obj^.right = NIL) OR (obj^.right^.typ # typ) THEN EXIT END ;
    Ws(", "); obj := obj^.right
   END ;
   Ws(": "); WriteType(typ, 3); Wch(";");
   Wln
  ELSIF (mode = Typ) & (obj^.marked) THEN
   IF first THEN Indent(1); Ws("TYPE"); Wln; first := FALSE END;
   Indent(2); WriteName(obj); Ws(" = ");
   IF obj^.typ^.strobj # obj THEN WriteType(obj^.typ, 0) (* alias type *)
   ELSE WriteForm(obj^.typ, 3)
   END ;
   Wch(";"); Wln;
   IF showObj THEN
    IF (obj^.typ^.form = Pointer) & (obj^.typ^.BaseTyp^.strobj # NIL) THEN
     WriteObject(obj^.typ^.BaseTyp^.strobj, obj^.typ^.BaseTyp^.strobj.mode)
    END
   ELSIF (obj^.typ^.form # Pointer) OR (obj^.typ^.BaseTyp^.strobj = NIL) THEN Wln
   END ;
  ELSIF mode IN {XProc, CProc} THEN first := FALSE; Indent(1); WriteProc(obj); Wln
  ELSIF mode = Mod THEN
   IF first THEN Indent(1); Ws("IMPORT "); first := FALSE; syspos := W.buf.len ELSE Ws(", ") END;
   WriteName(obj);
   IF option = "X" THEN Texts.WriteHex(W, obj^.a1) END
  END
 END WriteObject;
 PROCEDURE WriteScope(obj: Object; mode: INTEGER);
 BEGIN
  first := TRUE;
  WHILE obj # NIL DO
   IF (obj.mode = mode) OR ((mode = XProc) & (obj.mode = CProc)) THEN WriteObject(obj, mode) END ;
   obj := obj^.right
  END ;
  IF ~first THEN
   IF mode = Mod THEN Wch(";"); Wln END ;
   Wln
  END
 END WriteScope;
 PROCEDURE ReorderTypes(mod: Object); (* make <pointer, record> pairs *)
  VAR p, q, head, h: Object; typ: Struct;
 BEGIN q := mod^.link;
  NEW(head); head^.right := q;
  WHILE q # NIL DO
   IF (q.mode = Typ) & (q^.typ^.form = Pointer) & (q^.typ^.BaseTyp^.strobj # NIL) THEN
    p := head; typ := q^.typ^.BaseTyp;
    WHILE (p^.right # NIL) & ((p^.right^.mode # Typ) OR (p^.right^.typ # typ)) DO p := p^.right END ;
    IF p^.right # NIL THEN
     h := p^.right; p^.right := h^.right; h^.right := q^.right; q^.right := h
    END
   END ;
   q := q^.right
  END ;
  mod^.link := head^.right
 END ReorderTypes;
 PROCEDURE WriteModule(mod: Object);
 BEGIN
  Ws("DEFINITION "); WriteName(mod);
  IF option = "X" THEN Texts.WriteHex(W, mod^.a1) END ;
  Wch(";"); Wln; Wln;
  syspos := - W.buf.len; impSystem := FALSE;
  WriteScope(mod^.link, Mod);
  WriteScope(mod^.link, Con);
  ReorderTypes(mod); WriteScope(mod^.link, Typ);
  WriteScope(mod^.link, Var);
  WriteScope(mod^.link, XProc);
  Ws("END "); WriteName(mod); Wch(".");
  Wln
 END WriteModule;
 PROCEDURE Diff(i, j: INTEGER): INTEGER;
  VAR d: INTEGER; ch: CHAR;
 BEGIN
  REPEAT ch := IdBuf[i]; d := ORD(ch) - ORD(IdBuf[j]); INC(i); INC(j)
  UNTIL (d # 0) OR (ch = 0X);
  RETURN d
 END Diff;
 PROCEDURE Index(name: ARRAY OF CHAR): INTEGER;
  VAR id0, j: INTEGER; ch: CHAR; (*enter identifier*)
 BEGIN
  id0 := id; j := 0;
  IF id < IdBufLim THEN
   REPEAT ch := name[j]; IdBuf[id] := ch; INC(id); INC(j)
   UNTIL ch = 0X
  ELSE err := TRUE
  END ;
  RETURN id0
 END Index;
 PROCEDURE Insert(name: INTEGER; VAR obj: Object);
  VAR d: INTEGER; ob0, ob1: Object;
 BEGIN
  ob0 := topScope; ob1 := ob0^.right; d := 1;
  LOOP
   IF ob1 # NIL THEN
    d := Diff(name, ob1^.name);
    IF d < 0 THEN ob0 := ob1; ob1 := ob0^.left
    ELSIF d > 0 THEN ob0 := ob1; ob1 := ob0^.right
    ELSE ob1 := NIL (* already defined, cause duplication *)
    END
   ELSE (*insert*) NEW(ob1);
    IF d < 0 THEN ob0^.left := ob1 ELSE ob0^.right := ob1 END ;
    ob1^.left := NIL; ob1^.right := NIL; ob1^.name := name;
    ob1^.marked := FALSE; EXIT
   END
  END ;
  obj := ob1
 END Insert;
 PROCEDURE InsertSubClass(base, sub: Struct);
  VAR prev: Struct;
  PROCEDURE Less(typ1, typ2: Struct): BOOLEAN; (* return typ1 < typ2 *)
   VAR i: INTEGER;
  BEGIN
   i := Diff(GlbMod[typ1^.mno]^.name, GlbMod[typ2^.mno]^.name);
   IF i < 0 THEN RETURN TRUE
   ELSIF i = 0 THEN RETURN Diff(typ1^.strobj^.name, typ2^.strobj^.name) < 0
   ELSE RETURN FALSE
   END
  END Less;
 BEGIN
  IF base = NIL THEN base := types END ;
  prev := base^.sub;
  IF (prev = NIL) OR Less(sub, prev) THEN
   sub^.next := base^.sub; base^.sub := sub
  ELSE
   WHILE (prev^.next # NIL) & Less(prev^.next, sub) DO prev := prev^.next END;
   sub^.next := prev^.next; prev^.next := sub
  END
 END InsertSubClass;
 PROCEDURE InsertImport(obj, root: Object; VAR old: Object);
  VAR ob0, ob1: Object; d: INTEGER;
 BEGIN ob0 := root; ob1 := ob0^.right; d := 1;
  LOOP
   IF ob1 # NIL THEN
    d := Diff(obj^.name, ob1^.name);
    IF d = 0 THEN old := ob1; EXIT
    ELSE ob0 := ob1; ob1 := ob1^.right
    END
   ELSE ob1 := obj; ob0^.right := ob1;
    ob1^.left := NIL; ob1^.right := NIL; old := NIL; EXIT
   END
  END
 END InsertImport;
 PROCEDURE Append(VAR d: ARRAY OF CHAR; s: ARRAY OF CHAR);
  VAR i, j: INTEGER; ch: CHAR;
 BEGIN
  i := 0; WHILE d[i] # 0X DO INC(i) END ;
  j := 0; REPEAT ch := s[j]; d[i] := ch; INC(i); INC(j) UNTIL ch = 0X
 END Append;
 PROCEDURE ReadSym(name: ARRAY OF CHAR; VAR obj: Object);
  VAR i, j, m, s, h, h1, h2, class: INTEGER; k: LONGINT;
    nofLmod, strno, parlev, fldlev: INTEGER;
    old, mod: Object;
    typ: Struct;
    ch: CHAR;
    si: SHORTINT;
    xval: REAL; yval: LONGREAL;
    LocMod:  ARRAY maxImps OF Object;
    struct:  ARRAY 255 OF Struct;
    param, lastpar, fldlist, lastfld: ARRAY 6 OF Object;
    FileName: ARRAY 32 OF CHAR;
    SymFile: Files.File;
    SF: Files.Rider;
  PROCEDURE ReadXInt (VAR k: LONGINT); BEGIN Files.ReadNum(SF, k);  END ReadXInt;
  PROCEDURE ReadLInt (VAR k: LONGINT); BEGIN Files.ReadNum(SF, k) END ReadLInt;
  PROCEDURE ReadInt (VAR k: INTEGER); VAR i: LONGINT; BEGIN Files.ReadNum(SF, i); k := SHORT(i) END ReadInt;
  PROCEDURE ReadId;
   VAR i: INTEGER; ch: CHAR;
  BEGIN i := id;
   REPEAT
    Files.Read(SF, ch); IdBuf[i] := ch; INC(i)
   UNTIL ch = 0X;
   id := i
  END ReadId;
  PROCEDURE Err(s: ARRAY OF CHAR);
  BEGIN
   Ws(name); Ws(" -- "); Ws(s);
   Wln; Texts.Append(Oberon.Log, W.buf)
  END Err;
  PROCEDURE reverseList(p: Object);
   VAR q, r: Object;
  BEGIN q := NIL;
   WHILE p # NIL DO
    r := p^.link; p^.link := q; q := p; p := r
   END
  END reverseList;
  PROCEDURE AppendObj(VAR p: Object; obj: Object);
   VAR r: Object;
  BEGIN
   IF p = NIL THEN p := obj
   ELSE r := p; WHILE r^.link # NIL DO r := r^.link END ;
    r^.link := obj
   END
  END AppendObj;
 BEGIN (* ReadSym *)
  err := TRUE;
  nofLmod := 0; strno := firstStr;
  parlev := 0; fldlev := 0;
  COPY(name, FileName); Append(FileName, symFileExt);
  SymFile := Files.Old(FileName);
  IF SymFile # NIL THEN
   Files.Set(SF, SymFile, 0); Files.Read(SF, ch);
   IF ch = SFtag THEN
    struct[Undef] := undftyp; struct[Byte] := bytetyp;
    struct[Bool] := booltyp;  struct[Char] := chartyp;
    struct[SInt] := sinttyp;  struct[Int] := inttyp;
    struct[LInt] := linttyp;  struct[Real] := realtyp;
    struct[LReal] := lrltyp;  struct[Set] := settyp;
    struct[String] := stringtyp; struct[NilTyp] := niltyp;
    struct[NoTyp] := notyp; struct[Pointer] := sysptrtyp;                (*:*)
    LOOP (*read next item from symbol file*)
     Files.Read(SF, ch); class := ORD(ch);
     IF SF.eof THEN EXIT END ;
     CASE class OF
       0..7, 23, 25: (*object*)                           (*:*)
      NEW(obj); m := 0;
      ReadInt(s); obj^.typ := struct[s];
      CASE class OF
       1: obj^.mode := Con;
          CASE obj^.typ^.form OF
          | 1,2,3: Files.Read(SF, ch); obj^.a0 := ORD(ch)
          | 4: Files.Read(SF, si); obj^.a0 := si
          | 5: ReadXInt(obj^.a0)
          | 6, 9: ReadLInt(obj^.a0)
          | 7: Files.ReadBytes(SF, obj^.a0, 4)
          | 8: Files.ReadBytes(SF, obj^.a0, 4); Files.ReadBytes(SF, obj^.a1, 4)
          | 10: obj^.a0 := id; ReadId
          | 11: (*NIL*)
          END
       |2,3: obj^.mode := Typ; ReadInt(m);
          IF obj^.typ^.strobj = NIL THEN obj^.typ^.strobj := obj END;
          obj^.marked := class = 2
       |4, 23: obj^.mode := Var; ReadLInt(obj^.a0); obj^.marked := (class = 23)
       |5, 6, 7, 25:                               (*:*)
          h1 := 0; h2 := 0;                       (*:*)
          IF class = 5 THEN obj^.mode := IProc; ReadInt(h1)
          ELSIF class = 6 THEN obj^.mode := XProc; ReadInt(h1)
          ELSIF class = 25 THEN obj^.mode := TProc;
           ReadInt(s); ReadInt(h1); ReadInt(h2);
           typ := struct[s]
          ELSE obj^.mode := CProc; Files.Read(SF, ch); i := ORD(ch);
           obj^.a0 := id; obj^.a1 := i;
           WHILE i > 0 DO Files.Read(SF, IdBuf[id]); INC(id); DEC(i) END
          END ;
          IF class # 7 THEN obj^.a0 := h1 + h2 * 10000H END ;
          reverseList(lastpar[parlev]);
          obj^.link := param[parlev]^.right; DEC(parlev)
      END ;
      obj^.name := id; ReadId;
      IF (class = 6) & (fldlev > 0) THEN InsertImport(obj, fldlist[fldlev], old)
      ELSIF class = 25 THEN obj^.right := obj^.link; obj^.link:= NIL; AppendObj(typ^.link, obj)   (*:*)
      ELSE
       IF IdBuf[obj^.name] # 0X THEN
        InsertImport(obj, LocMod[m], old);
        IF (old # NIL) & (obj^.mode = Typ) THEN struct[s] := old^.typ
        ELSIF (obj^.mode = Typ) & (obj^.typ^.form = Record) & (obj^.typ^.strobj = obj) THEN
         InsertSubClass(typ^.BaseTyp, typ)
        END
       END
      END
     | 8..12: (*structure*)
      NEW(typ); typ^.strobj := NIL; typ^.ref := 0;
      ReadInt(s); typ^.BaseTyp := struct[s];
      ReadInt(s); typ^.mno := SHORT(SHORT(LocMod[s]^.a0));
      CASE class OF
        8: typ^.form := Pointer; typ^.size := 4; typ^.n := 0
      |  9: typ^.form := ProcTyp; typ^.size := 4;
         reverseList(lastpar[parlev]);
         typ^.link := param[parlev]^.right; DEC(parlev)
      | 10: typ^.form := Array; ReadLInt(typ^.size); typ^.n := typ^.size DIV typ^.BaseTyp^.size
      | 11: typ^.form := DynArr; ReadLInt(typ^.size); ReadXInt(typ^.adr)
      | 12: typ^.form := Record;
         ReadLInt(typ^.size);
         reverseList(lastfld[fldlev]);
         typ^.link := fldlist[fldlev]^.right; DEC(fldlev);
         typ^.level := typ^.BaseTyp^.level;
         IF typ^.BaseTyp = notyp THEN typ^.BaseTyp := NIL END ;
         ReadXInt(typ^.adr);  (*of descriptor*)
      END ;
      struct[strno] := typ; INC(strno)
     | 13: (*parameter list start*)
      NEW(obj); obj^.mode := Head; obj^.right := NIL;
      IF parlev < 6 THEN INC(parlev); param[parlev] := obj; lastpar[parlev] := NIL
      ELSE RETURN
      END
     | 14, 15: (*parameter*)
      NEW(obj);
      IF class = 14 THEN obj^.mode := Var ELSE obj^.mode := Ind END ;
      ReadInt(s); obj^.typ := struct[s];
      ReadXInt(obj^.a0); obj^.name := id; ReadId;
      InsertImport(obj, param[parlev], old);
      obj^.link := lastpar[parlev]; lastpar[parlev] := obj
     | 16: (*start field list*)
      NEW(obj); obj^.mode := Head; obj^.right := NIL;
      IF fldlev < 5 THEN INC(fldlev); fldlist[fldlev] := obj; lastfld[fldlev] := NIL
      ELSE RETURN
      END
     | 17, 24: (*field, rfield*)
      NEW(obj); obj^.mode := Fld; ReadInt(s);
      obj^.marked := (class = 24);
      obj^.typ := struct[s]; ReadLInt(obj^.a0);
      obj^.name := id; ReadId;
      obj^.link := lastfld[fldlev]; lastfld[fldlev] := obj;
      InsertImport(obj, fldlist[fldlev], old)
     | 18, 19: (*hidden pointer field, hidden procedure field *)
      ReadLInt(k)
     | 20: (*fixup pointer typ*)
      ReadInt(s); typ := struct[s];
      ReadInt(s);
      IF typ^.BaseTyp = undftyp THEN typ^.BaseTyp := struct[s] END
     | 21: (*skip sysflag*)
      ReadInt(s); ReadInt(s)
     | 22: (*module anchor*)
      ReadLInt(k); m := id; ReadId; i := 0;
      WHILE (i < nofGmod) & (Diff(m, GlbMod[i]^.name) # 0) DO
       INC(i)
      END ;
      IF i < nofGmod THEN (*module already present*)
       IF k # GlbMod[i]^.a1 THEN Err("invalid module key"); RETURN END ;
       obj := GlbMod[i]
      ELSE NEW(obj);
       obj^.mode := Head; obj^.name := m;
       obj^.a1 := k; obj^.a0 := nofGmod; obj^.right := NIL;
       IF nofGmod < maxImps THEN GlbMod[nofGmod] := obj; INC(nofGmod)
       ELSE RETURN
       END
      END ;
      IF nofLmod < 20 THEN LocMod[nofLmod] := obj; INC(nofLmod)
      ELSE Err("too many imports"); RETURN
      END ;
      IF nofLmod > 1 THEN NEW(mod); mod^.name := obj^.name; mod^.mode := Mod; mod^.a1 := k;
       InsertImport(mod, LocMod[0], old)
      END
     | 26: (*nofmethods*)
      ReadInt(s); typ := struct[s]; ReadInt(s); typ.n := s
     | 27: (*hidden method*)
      Files.Read(SF, ch); Files.Read(SF, ch); Files.Read(SF, ch);
     ELSE Err("invalid symbol file"); RETURN
     END
    END (*LOOP*) ;
    Insert(Index(name), obj);
    obj^.mode := Mod; obj^.link := LocMod[0]^.right;
    obj^.a0  := LocMod[0]^.a0; obj^.a1  := LocMod[0]^.a1; obj^.typ := notyp;
   ELSE Err("not a symbol file"); RETURN
   END
  ELSE Err("symbol file not found"); RETURN
  END;
  err := FALSE
 END ReadSym;
 PROCEDURE DisplayW(name: ARRAY OF CHAR);
  VAR mV: MenuViewers.Viewer; T: Texts.Text; x, y: INTEGER;
 BEGIN
  T := TextFrames.Text(""); Texts.Append(T, W.buf);
  IF (syspos # 0) & impSystem THEN
   IF syspos > 0 THEN Ws("SYSTEM, ") ELSE Wch(09X); Ws("IMPORT SYSTEM;"); Wln; Wln END;
   Texts.Insert(T, ABS(syspos), W.buf);
   syspos := 0
  END ;
  Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y);
  mV := MenuViewers.New(
   TextFrames.NewMenu(name, "System.Close System.Copy System.Grow Edit.Search Edit.Store "),
   TextFrames.NewText(T, 0),
   TextFrames.menuH, x, y)
 END DisplayW;
 PROCEDURE InitStruct(VAR typ: Struct; f: SHORTINT);
 BEGIN NEW(typ); typ^.form := f; typ^.ref := f; typ^.size := 1
 END InitStruct;
 PROCEDURE Init;
  PROCEDURE EnterTyp(name: ARRAY OF CHAR; form: SHORTINT; size: INTEGER; VAR res: Struct);
   VAR obj: Object; typ: Struct;
  BEGIN Insert(Index(name), obj);
   NEW(typ); obj^.mode := Typ; obj^.typ := typ;
   typ^.form := form; typ^.strobj := obj; typ^.size := size;
   typ^.mno := 0; typ^.ref := form; res := typ
  END EnterTyp;
  PROCEDURE OpenScope(level: INTEGER; owner: Object);
   VAR head: Object;
  BEGIN NEW(head);
   head^.mode := Head; head^.a0 := level; head^.link := owner;
   head^.left := topScope; head^.right := NIL; topScope := head
  END OpenScope;
 BEGIN
  IdBuf[0] := 0X; id := 1; topScope := NIL; OpenScope(0, NIL);
  EnterTyp("CHAR", Char, 1, chartyp);
  EnterTyp("SET", Set, 4, settyp);
  EnterTyp("REAL", Real, 4, realtyp);
  EnterTyp("INTEGER", Int, 2, inttyp);
  EnterTyp("LONGINT",  LInt, 4, linttyp);
  EnterTyp("LONGREAL", LReal, 8, lrltyp);
  EnterTyp("SHORTINT", SInt, 1, sinttyp);
  EnterTyp("BOOLEAN", Bool, 1, booltyp);
  EnterTyp("SYSTEM.BYTE", Byte, 1, bytetyp);
  EnterTyp("SYSTEM.PTR", Pointer, 4, sysptrtyp);                     (*:*)
  universe := topScope; topScope^.right := NIL;
  nofGmod := 1; topScope^.name := 0; GlbMod[0] := topScope; OpenScope(0, NIL);
  NEW(types);
 END Init;
 PROCEDURE GetArgs(VAR S: Texts.Scanner);
  VAR text: Texts.Text; beg, end, time: LONGINT;
 BEGIN
  Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  IF (S.line#0) OR (S.class#Texts.Name) THEN
   Oberon.GetSelection(text, beg, end, time);
   IF time>=0 THEN Texts.OpenScanner(S, text, beg); Texts.Scan(S) END
  END
 END GetArgs;
 PROCEDURE Option(VAR S: Texts.Scanner);
 BEGIN option := 0X;
  Texts.Scan(S);
  IF (S.class=Texts.Char) & (S.c=optionChar) THEN Texts.Scan(S);
   IF S.class=Texts.Name THEN option := S.s[0]; Texts.Scan(S) END
  END
 END Option;
 PROCEDURE QualIdent(VAR name, first, second: ARRAY OF CHAR);
  VAR i, j: INTEGER; ch: CHAR;
 BEGIN
  i:=0; ch:=name[0];
  WHILE (ch#".") & (ch#0X) DO first[i]:=ch; INC(i); ch:=name[i] END;
  first[i]:=0X; INC(i); j:=0; ch:=name[i];
  WHILE ch#0X DO second[j]:=ch; INC(i); INC(j); ch:=name[i] END;
  second[j]:=0X
 END QualIdent;
 PROCEDURE ShowDef*;
  VAR
   S: Texts.Scanner;
   mod, dummy: ARRAY 32 OF CHAR;
   obj: Object;
 BEGIN
  GetArgs(S);
  IF S.class=Texts.Name THEN
   QualIdent(S.s, mod, dummy); Option(S);
   Init;
   ReadSym(mod, obj);
   IF ~err THEN
    showObj := FALSE; WriteModule(obj);
    Append(mod, ".Def"); DisplayW(mod)
   END
  END
 END ShowDef;
 PROCEDURE ShowObj*;
  VAR
   S: Texts.Scanner;
   mod, objName, qualid: ARRAY 32 OF CHAR;
   obj: Object;
 BEGIN
  GetArgs(S);
  IF S.class=Texts.Name THEN
   COPY(S.s, qualid); QualIdent(S.s, mod, objName); Option(S);
   Init;
   ReadSym(mod, obj);
   IF ~err THEN
    obj := obj^.link; id := Index(objName);
    WHILE (obj # NIL) & (Diff(id, obj^.name) # 0) DO obj := obj^.right END ;
    IF obj # NIL THEN
     showObj := TRUE; first := TRUE;
     WriteObject(obj, obj^.mode);
     DisplayW(qualid)
    END
   END
  END
 END ShowObj;
 PROCEDURE ShowTree*;
  VAR
   S: Texts.Scanner;
   modName, dummy: ARRAY 32 OF CHAR;
   obj: Object;
 BEGIN
  GetArgs(S); Init;
  WHILE S.class = Texts.Name DO
   QualIdent(S.s, modName, dummy); Option(S);
   ReadSym(modName, obj); IF err THEN RETURN END
  END ;
  WriteRecords(types^.sub, 1);
  DisplayW("Browser.ShowTree")
 END ShowTree;
 PROCEDURE SetExtension*; (* "sym file extension"*)
  VAR S: Texts.Scanner;
 BEGIN GetArgs(S);
  IF S.class = Texts.String THEN COPY(S.s, symFileExt) END
 END SetExtension;
BEGIN
 Texts.OpenWriter(W);
 InitStruct(undftyp, Undef); InitStruct(notyp, NoTyp);
 InitStruct(stringtyp, String); InitStruct(niltyp, NilTyp);
 symFileExt := ".Sym"
END Browser.